home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / DBD / ExampleP.pm next >
Encoding:
Text File  |  1999-12-28  |  4.2 KB  |  179 lines
  1. {
  2.     package DBD::ExampleP;
  3.  
  4.     require DBI;
  5.  
  6.     @EXPORT = qw(); # Do NOT @EXPORT anything.
  7.  
  8.  
  9.     @statnames = qw(dev ino mode nlink uid gid
  10.     rdev size atime mtime ctime blksize blocks name);
  11.     @statnames{@statnames} = (0 .. @statnames-1);
  12.     @stattypes = qw(1 1 1 1 1 1 1 1 3 3 3 1 1 2);
  13.     @stattypes{@statnames} = @stattypes;
  14.  
  15.     $drh = undef;    # holds driver handle once initialised
  16.     $err = 0;        # The $DBI::err value
  17.     $gensym = "SYM000"; # used by st::execute() for filehandles
  18.  
  19.     sub driver{
  20.     return $drh if $drh;
  21.     my($class, $attr) = @_;
  22.     $class .= "::dr";
  23.     ($drh) = DBI::_new_drh($class, {
  24.         'Name' => 'ExampleP',
  25.         'Version' => '$Revision: 1.6 $',
  26.         'Attribution' => 'DBD Example Perl stub by Tim Bunce',
  27.         }, ['example implementors private data']);
  28.     $drh;
  29.     }
  30.  
  31.     1;
  32. }
  33.  
  34.  
  35. {   package DBD::ExampleP::dr; # ====== DRIVER ======
  36.     $imp_data_size = 0;
  37.     use strict;
  38.  
  39.     sub my_handler {
  40.     my($self, $type, @args) = @_;
  41.     return 0 unless $type eq 'ERROR';
  42.     ${$self->{Err}}    = $args[0];
  43.     ${$self->{Errstr}} = $args[1];
  44.     1;    # handled
  45.     }
  46.  
  47.     sub connect { # normally overridden, but a handy default
  48.         my($drh, $dbname, $user, $auth)= @_;
  49.         my($this) = DBI::_new_dbh($drh, {
  50.         'Name' => $dbname,
  51.         'User' => $user,
  52.         'Handlers' => [ \&my_handler ],    # deprecated, don't do this
  53.         });
  54.         $this;
  55.     }
  56.  
  57.     sub disconnect_all {
  58.     }
  59.     sub DESTROY { undef }
  60. }
  61.  
  62.  
  63. {   package DBD::ExampleP::db; # ====== DATABASE ======
  64.     $imp_data_size = 0;
  65.     use strict;
  66.  
  67.     sub prepare {
  68.     my($dbh, $statement)= @_;
  69.     my($fields, $param)
  70.         = $statement =~ m/^select ([\w,\s]+)\s+from\s+(.*?)/i;
  71.     my(@fields) = split(/\s*,\s*/, $fields);
  72.  
  73.     my(@bad) = map($DBD::ExampleP::statnames{$_} ? () : $_, @fields);
  74.     if (@bad) {
  75.         $dbh->event("ERROR", 1, "Unknown field names: @bad");
  76.         return undef;
  77.     }
  78.  
  79.     my($outer, $sth) = DBI::_new_sth($dbh, {
  80.         'Statement'     => $statement,
  81.         'fields'        => \@fields,
  82.         }, ['example implementors private data']);
  83.  
  84.     $outer->{NAME} = \@fields;
  85.     $outer->{NULLABLE} = (0) x @fields;
  86.     $outer->{NUM_OF_FIELDS} = @fields;
  87.     $outer->{NUM_OF_PARAMS} = 1;
  88.  
  89.     $outer;
  90.     }
  91.  
  92.     sub disconnect {
  93.     return 1;
  94.     }
  95.  
  96.     sub FETCH {
  97.     my ($dbh, $attrib) = @_;
  98.     return 1 if $attrib eq 'AutoCommit';
  99.     return $dbh->DBD::_::st::FETCH($attrib);
  100.     }
  101.  
  102.     sub STORE {
  103.     my ($dbh, $attrib, $value) = @_;
  104.     if ($attrib eq 'AutoCommit') {
  105.         return 1 if $value;    # is already set
  106.         croak("Can't disable AutoCommit");
  107.     }
  108.     return $dbh->DBD::_::st::STORE($attrib, $value);
  109.     }
  110.     sub DESTROY { undef }
  111. }
  112.  
  113.  
  114. {   package DBD::ExampleP::st; # ====== STATEMENT ======
  115.     $imp_data_size = 0;
  116.     use strict; no strict 'refs'; # cause problems with filehandles
  117.  
  118.     sub bind_param {
  119.     my($sth, $param, $value, $attribs) = @_;
  120.     $sth->{'param'}->[$param] = $value;
  121.     }
  122.     
  123.     sub execute {
  124.     my($sth, @dir) = @_;
  125.     my $dir;
  126.     if (@dir) {
  127.         $dir = $dir[0];
  128.     } else {
  129.         $dir = $sth->{'param'}->[1] || die "No bind_param";
  130.     }
  131.     $sth->finish;
  132.     $sth->{'datahandle'} = "DBD::ExampleP::".++$DBD::ExampleP::gensym;
  133.     opendir($sth->{'datahandle'}, $dir)
  134.         or ($sth->event("ERROR", 2, "opendir($dir): $!"), return undef);
  135.     $sth->{'dir'} = $dir;
  136.     1;
  137.     }
  138.  
  139.     sub fetch {
  140.     my($sth) = @_;
  141.     my $f = readdir($sth->{'datahandle'});
  142.     unless($f){
  143.         $sth->finish;     # no more data so finish
  144.         return ();
  145.     }
  146.     my(%s); # fancy a slice of a hash?
  147.     @s{@DBD::ExampleP::statnames} = (stat("$sth->{'dir'}/$f"), $f);
  148.     [ @s{ @{$sth->{'fields'}} } ];
  149.     }
  150.  
  151.     sub finish {
  152.     my($sth) = @_;
  153.     return undef unless $sth->{'datahandle'};
  154.     closedir($sth->{'datahandle'});
  155.     $sth->{'datahandle'} = undef;
  156.     return 1;
  157.     }
  158.  
  159.     sub FETCH {
  160.     my ($sth, $attrib) = @_;
  161.     if ($attrib eq 'DATA_TYPE'){
  162.         my(@t) = @DBD::ExampleP::stattypes{@{$sth->{'fields'}}};
  163.         return \@t;
  164.     }
  165.     return $sth->DBD::_::st::FETCH($attrib);
  166.     }
  167.  
  168.     sub STORE {
  169.     my ($sth, $attrib, $value) = @_;
  170.     return $sth->{$attrib}=$value
  171.         if $attrib eq 'NAME' or $attrib eq 'NULLABLE';
  172.     return $sth->DBD::_::st::STORE($attrib, $value);
  173.     }
  174.  
  175.     sub DESTROY { undef }
  176. }
  177.  
  178. 1;
  179.